.ipynb .pdf

repository open issue

Binder Live Code

Contents

#install.packages(c("patchwork", "tidylog", "leaflet", "htmltools", "highcharter"))

library(patchwork)
library(tidyverse)
library(tidylog)

── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.1 ──

✔ ggplot2 3.3.5     ✔ purrr   0.3.4
✔ tibble  3.1.6     ✔ dplyr   1.0.7
✔ tidyr   1.1.4     ✔ stringr 1.4.0
✔ readr   2.1.1     ✔ forcats 0.5.1

── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

Attaching package: ‘tidylog’

The following objects are masked from ‘package:dplyr’:

    add_count, add_tally, anti_join, count, distinct, distinct_all,
    distinct_at, distinct_if, filter, filter_all, filter_at, filter_if,
    full_join, group_by, group_by_all, group_by_at, group_by_if,
    inner_join, left_join, mutate, mutate_all, mutate_at, mutate_if,
    relocate, rename, rename_all, rename_at, rename_if, rename_with,
    right_join, sample_frac, sample_n, select, select_all, select_at,
    select_if, semi_join, slice, slice_head, slice_max, slice_min,
    slice_sample, slice_tail, summarise, summarise_all, summarise_at,
    summarise_if, summarize, summarize_all, summarize_at, summarize_if,
    tally, top_frac, top_n, transmute, transmute_all, transmute_at,
    transmute_if, ungroup

The following objects are masked from ‘package:tidyr’:

    drop_na, fill, gather, pivot_longer, pivot_wider, replace_na,
    spread, uncount

The following object is masked from ‘package:stats’:

    filter

options(repr.plot.width = 16, repr.plot.height = 8)

ggplot() +
  geom_bar(data = diamonds,
           aes(x = cut, fill = cut)
           ) +
  labs(x = "Cut of the Diamond", y = "Frequency") +
  theme(legend.position = "none") -> p1

ggplot() +
  geom_bar(data = diamonds,
           aes(x = color, fill = color)
           ) +
  labs(x = "Color of the Diamond", y = "Frequency") +
  theme(legend.position = "none") -> p2

ggplot() +
  geom_point(data = diamonds,
           aes(x = carat, y = price, color = cut)
           ) +
  labs(x = "Weight of the Diamond", y = "Price of the Diamond", color = "") +
  theme(legend.position = "bottom") -> p3

ggplot() +
  geom_boxplot(data = diamonds,
           aes(x = price, y = clarity, fill = cut)
           ) +
  labs(y = "Clarity of the Diamond", x = "Price of the Diamond", fill = "") +
  theme(legend.position = "bottom") -> p4

p1; p2; p3; p4

p1 + p2 + p3 

(p1 + p2) / p3

p1 | (p2 + p3)

p1 | (p2 / p3)

options(repr.plot.width = 16, repr.plot.height = 16)

(p1 + p2) / (p3 + p4)

(p1 + p2) / (p3 + p4) +
  plot_annotation(
  title = 'The surprising truth about diamonds',
  subtitle = 'These plots will reveal untold secrets about one of our beloved data-sets',
  caption = 'Disclaimer: None of these plots are insightful',
  tag_levels = c('a', '1'),
  tag_prefix = 'Fig. ',
  tag_sep = '.',
  tag_suffix = ':'
  ) &
  theme(
    plot.tag.position = c(0, 1),
    plot.tag = element_text(size = 9, hjust = 0, vjust = 0, color = "steelblue")
    )

options(repr.plot.width = 16, repr.plot.height = 8)

(p1 + plot_spacer() + p2 + plot_spacer() + p3)

options(repr.plot.width = 16, repr.plot.height = 16)

p1 + p2 + p3 + p4 + 
  plot_layout(widths = c(2, 1))

p1 + p2 + p3 + p4 + 
  plot_layout(
    widths = c(2, 1),
    heights = unit(c(5, 1), c('cm', 'null'))
    )

layout <- "
##BBBB
AACCDD
##CCDD
"
p2 + p3 + p4 + p1 + 
  plot_layout(design = layout)

layout <- c(
  area(t = 2, l = 1, b = 5, r = 4),
  area(t = 1, l = 3, b = 3, r = 5)
  )

p3 + p4 + 
  plot_layout(design = layout)

layout <- '
A##
#B#
##C
'
wrap_plots(A = p1, B = p2, C = p3, design = layout)

library(urbnmapr)

ggplot() +
  geom_polygon(
    data = states, 
    aes(x = long, y = lat, group = group, fill = state_abbv)
    ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() + 
  theme(legend.position = "none") +
  labs(title = "Fixed!!") -> mymap

mymap + p1 + p2 + p3

head(states)

A tibble: 6 × 9

long	lat	order	hole	piece	group	state_fips	state_abbv	state_name
<dbl>	<dbl>	<int>	<lgl>	<fct>	<fct>	<chr>	<chr>	<chr>
-88.47323	31.89386	1	FALSE	1	01.1	01	AL	Alabama
-88.46888	31.93026	2	FALSE	1	01.1	01	AL	Alabama
-88.46866	31.93317	3	FALSE	1	01.1	01	AL	Alabama
-88.45504	32.03972	4	FALSE	1	01.1	01	AL	Alabama
-88.45496	32.04058	5	FALSE	1	01.1	01	AL	Alabama
-88.45342	32.05305	6	FALSE	1	01.1	01	AL	Alabama

head(counties)

A tibble: 6 × 12

long	lat	order	hole	piece	group	county_fips	state_abbv	state_fips	county_name	fips_class	state_name
<dbl>	<dbl>	<int>	<lgl>	<fct>	<fct>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>
-86.91760	32.66417	1	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.81657	32.66012	2	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.71339	32.66173	3	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.71422	32.70569	4	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.41312	32.70739	5	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.41117	32.40994	6	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama

ggplot() +
  geom_polygon(
      data = states, 
      aes(
          x = long, 
          y = lat, 
          group = group),
      fill = "white", 
      color = "steelblue"
  ) +
  coord_fixed(1.3) 

ggplot() +
  geom_polygon(
      data = states, 
      aes(
          x = long, 
          y = lat, 
          group = group, 
          fill = state_name),
      color = "white"
      ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(legend.position = "none")

head(statedata)

A tibble: 6 × 6

year	state_fips	state_name	hhpop	horate	medhhincome
<int>	<chr>	<chr>	<int>	<dbl>	<int>
2015	01	Alabama	1846380	0.6814329	44700
2015	02	Alaska	250183	0.6311860	70600
2015	04	Arizona	2463012	0.6206178	51000
2015	05	Arkansas	1144657	0.6546031	42000
2015	06	California	12895471	0.5372219	64600
2015	08	Colorado	2074517	0.6389425	63500

states %>%
  left_join(
      statedata, 
      by = c("state_fips", "state_name")
  ) -> state.df

left_join: added 4 columns (year, hhpop, horate, medhhincome)

           > rows only in x        0

           > rows only in y  (     0)

           > matched rows     83,933

           >                 ========

           > rows total       83,933

head(state.df)

A tibble: 6 × 13

long	lat	order	hole	piece	group	state_fips	state_abbv	state_name	year	hhpop	horate	medhhincome
<dbl>	<dbl>	<int>	<lgl>	<fct>	<fct>	<chr>	<chr>	<chr>	<int>	<int>	<dbl>	<int>
-88.47323	31.89386	1	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700
-88.46888	31.93026	2	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700
-88.46866	31.93317	3	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700
-88.45504	32.03972	4	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700
-88.45496	32.04058	5	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700
-88.45342	32.05305	6	FALSE	1	01.1	01	AL	Alabama	2015	1846380	0.6814329	44700

options(repr.plot.width = 24, repr.plot.height = 16)

ggplot() +
  geom_polygon(
      data = state.df, 
      aes(
          x = long, 
          y = lat, 
          group = group, 
          fill = medhhincome
          ),
          color = "white"
  ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  labs(
    title = "Median Household Income in the States (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "magma") +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) 

counties %>%
  left_join(
      countydata, 
      by = c("county_fips")
  ) -> county.df

left_join: added 4 columns (year, hhpop, horate, medhhincome)

           > rows only in x         0

           > rows only in y  (      0)

           > matched rows     208,874

           >                 =========

           > rows total       208,874

ggplot() +
  geom_polygon(data = county.df, 
               aes(x = long, y = lat, group = group, fill = medhhincome),
               color = "white", size = 0.05) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) +
  labs(
    title = "Median Household Income in the Counties (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "magma")

county.df %>%
  filter(state_abbv == "FL") %>%
  ggplot() +
  geom_polygon(
               aes(x = long, y = lat, group = group,
                   fill = medhhincome),
               color = "white", size = 0.05
               ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) +
  labs(
    title = "Median Household Income in Floria Counties (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "plasma")

filter: removed 203,791 rows (98%), 5,083 rows remaining

library(tigris)
options(tigris_use_cache = TRUE)

places(
  state = "NH", cb = TRUE, year = 2018, progress_bar = FALSE
  ) -> places.nh

To enable 
caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.

places.nh %>%
    head()

Registered S3 method overwritten by 'geojsonsf':
  method        from   
  print.geojson geojson

A sf: 6 × 10

	STATEFP	PLACEFP	PLACENS	AFFGEOID	GEOID	NAME	LSAD	ALAND	AWATER	geometry
	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<dbl>	<dbl>	<POLYGON [°]>
1	33	61860	02378088	1600000US3361860	3361860	Pittsfield	57	4114545	0	POLYGON ((-71.34923 43.2990...
2	33	67460	02629738	1600000US3367460	3367460	Sanbornville	57	4106641	3626	POLYGON ((-71.04123 43.5649...
3	33	87140	02378099	1600000US3387140	3387140	Woodsville	57	2271155	63295	POLYGON ((-72.04107 44.1542...
4	33	12900	00873567	1600000US3312900	3312900	Claremont	25	111766137	2323426	POLYGON ((-72.41538 43.3802...
5	33	11300	02378055	1600000US3311300	3311300	Charlestown	57	2107485	121062	POLYGON ((-72.43447 43.2304...
6	33	78340	02629744	1600000US3378340	3378340	Walpole	57	3152287	27471	POLYGON ((-72.43535 43.0751...

places.nh %>%
  fortify(region = "GEOID") -> nh.df

names(nh.df)

1. 'STATEFP'
2. 'PLACEFP'
3. 'PLACENS'
4. 'AFFGEOID'
5. 'GEOID'
6. 'NAME'
7. 'LSAD'
8. 'ALAND'
9. 'AWATER'
10. 'geometry'

nh.df %>%
    head()

A sf: 6 × 10

	STATEFP	PLACEFP	PLACENS	AFFGEOID	GEOID	NAME	LSAD	ALAND	AWATER	geometry
	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<dbl>	<dbl>	<POLYGON [°]>
1	33	61860	02378088	1600000US3361860	3361860	Pittsfield	57	4114545	0	POLYGON ((-71.34923 43.2990...
2	33	67460	02629738	1600000US3367460	3367460	Sanbornville	57	4106641	3626	POLYGON ((-71.04123 43.5649...
3	33	87140	02378099	1600000US3387140	3387140	Woodsville	57	2271155	63295	POLYGON ((-72.04107 44.1542...
4	33	12900	00873567	1600000US3312900	3312900	Claremont	25	111766137	2323426	POLYGON ((-72.41538 43.3802...
5	33	11300	02378055	1600000US3311300	3311300	Charlestown	57	2107485	121062	POLYGON ((-72.43447 43.2304...
6	33	78340	02629744	1600000US3378340	3378340	Walpole	57	3152287	27471	POLYGON ((-72.43535 43.0751...

ggplot() +
    geom_polygon(
        data = subset(state.df, state_name == "New Hampshire"),
        aes(x = long, y = lat, group = group),
        fill = "white", color = "black"
        ) + 
    geom_sf(
        data = nh.df,
        aes(fill = GEOID)
        ) +
  ggthemes::theme_map() +
  theme(legend.position = "none")

load("data/nh.data.RData")

head(nh.data)

A tibble: 6 × 3

GEOID	NAME	population
<chr>	<chr>	<dbl>
3300980	Alton CDP, New Hampshire	168
3301220	Amherst CDP, New Hampshire	709
3301620	Antrim CDP, New Hampshire	1232
3301940	Ashland CDP, New Hampshire	1353
3303620	Bartlett CDP, New Hampshire	104
3304660	Belmont CDP, New Hampshire	1814

nh.df %>%
  left_join(
      nh.data, 
      by = c("GEOID" = "GEOID")
  ) -> nh

left_join: added 3 columns (NAME.x, NAME.y, population)

           > rows only in x    0

           > rows only in y  ( 0)

           > matched rows     97

           >                 ====

           > rows total       97

head(nh)

A sf: 6 × 12

	STATEFP	PLACEFP	PLACENS	AFFGEOID	GEOID	NAME.x	LSAD	ALAND	AWATER	NAME.y	population	geometry
	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<dbl>	<dbl>	<chr>	<dbl>	<POLYGON [°]>
1	33	61860	02378088	1600000US3361860	3361860	Pittsfield	57	4114545	0	Pittsfield CDP, New Hampshire	1586	POLYGON ((-71.34923 43.2990...
2	33	67460	02629738	1600000US3367460	3367460	Sanbornville	57	4106641	3626	Sanbornville CDP, New Hampshire	581	POLYGON ((-71.04123 43.5649...
3	33	87140	02378099	1600000US3387140	3387140	Woodsville	57	2271155	63295	Woodsville CDP, New Hampshire	903	POLYGON ((-72.04107 44.1542...
4	33	12900	00873567	1600000US3312900	3312900	Claremont	25	111766137	2323426	Claremont city, New Hampshire	13016	POLYGON ((-72.41538 43.3802...
5	33	11300	02378055	1600000US3311300	3311300	Charlestown	57	2107485	121062	Charlestown CDP, New Hampshire	1029	POLYGON ((-72.43447 43.2304...
6	33	78340	02629744	1600000US3378340	3378340	Walpole	57	3152287	27471	Walpole CDP, New Hampshire	519	POLYGON ((-72.43535 43.0751...

ggplot() +
  geom_polygon(
    data = subset(
        state.df, 
        state_name == "New Hampshire"
    ),
    aes(
        x = long, 
        y = lat, 
        group = group
    ),
      fill = "white", 
      color = "black"
    ) +
  geom_sf(
    data = nh,
    aes(fill = population)
    ) +
  coord_sf() +
  scale_fill_viridis_c(option = "viridis") + 
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")  
  ) +
  labs(
    fill = "Population Size",
    title = "Population Distribution in New Hampshire's Places",
    subtitle = "(American Community Survey, 2014-2018)"
       )

readr::read_csv(
    "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-12-03/tickets.csv"
    ) %>%
  mutate(
    year = lubridate::year(issue_datetime),
    month = lubridate::month(issue_datetime)
         ) %>%
  filter(month == 12, lon > -75.5) %>%
  sample_frac(0.2) -> tickets

Rows: 1260891 Columns: 7

── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (2): violation_desc, issuing_agency
dbl  (4): fine, lat, lon, zip_code
dttm (1): issue_datetime

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

mutate: new variable 'year' (double) with one unique value and 0% NA

        new variable 'month' (double) with 12 unique values and 0% NA

filter: removed 1,169,690 rows (93%), 91,201 rows remaining

sample_frac: removed 72,961 rows (80%), 18,240 rows remaining

tickets %>%
  unite(
      display, 
      c(issuing_agency, issue_datetime, fine),
      sep = "; ", 
      remove = FALSE
  ) -> tickets

library(leaflet)
library(htmltools)
library(widgetframe)

Loading required package: htmlwidgets

lst <- list()

leaflet(tickets) %>%
  addTiles() %>%
  addCircles(
      lng = ~ lon, 
      lat = ~ lat, 
      popup = ~htmlEscape(display),
      color = "steelblue", 
      opacity = 0.10
  ) -> leaf01

leaf01 -> lst

htmltools::tagList(lst)

readr::read_csv(
    "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv"
    ) -> covid 

Rows: 2050611 Columns: 6

── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (3): county, state, fips
dbl  (2): cases, deaths
date (1): date

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

covid %>%
  filter(
      state == "Ohio", date == "2020-04-17"
  ) -> cov19

filter: removed 2,050,524 rows (>99%), 87 rows remaining

library(housingData)

geoCounty %>%
  filter(state == "OH") %>%
  separate(
      county,
      into = c("countyname", "extra"),
      sep = " County",
      remove = TRUE
  ) %>%
  mutate(
      countyname = stringr::str_to_sentence(countyname)
  ) -> oh

filter: removed 2,987 rows (97%), 88 rows remaining

mutate: changed one value (1%) of 'countyname' (0 new NA)

oh %>%
  left_join(
      cov19, 
      by = c("countyname" = "county")
  ) -> ohcov19

head(ohcov19)

left_join: added 7 columns (fips.x, state.x, date, state.y, fips.y, …)

           > rows only in x    2

           > rows only in y  ( 1)

           > matched rows     86

           >                 ====

           > rows total       88

A data.frame: 6 × 13

	fips.x	countyname	extra	state.x	lon	lat	rMapState	rMapCounty	date	state.y	fips.y	cases	deaths
	<fct>	<chr>	<chr>	<fct>	<dbl>	<dbl>	<fct>	<fct>	<date>	<chr>	<chr>	<dbl>	<dbl>
1	39001	Adams		OH	-83.46359	38.85662	ohio	adams	2020-04-17	Ohio	39001	3	0
2	39003	Allen		OH	-84.10825	40.77675	ohio	allen	2020-04-17	Ohio	39003	65	9
3	39005	Ashland		OH	-82.26922	40.86122	ohio	ashland	2020-04-17	Ohio	39005	5	0
4	39007	Ashtabula		OH	-80.75647	41.71017	ohio	ashtabula	2020-04-17	Ohio	39007	54	4
5	39009	Athens		OH	-82.04053	39.34576	ohio	athens	2020-04-17	Ohio	39009	3	1
6	39011	Auglaize		OH	-84.22192	40.56421	ohio	auglaize	2020-04-17	Ohio	39011	21	1

ohcov19 %>%
  unite(
      display, 
      c(countyname, cases), 
      sep = ": ",
      remove = FALSE
  ) -> ohcov19

head(ohcov19)

A data.frame: 6 × 14

	fips.x	display	countyname	extra	state.x	lon	lat	rMapState	rMapCounty	date	state.y	fips.y	cases	deaths
	<fct>	<chr>	<chr>	<chr>	<fct>	<dbl>	<dbl>	<fct>	<fct>	<date>	<chr>	<chr>	<dbl>	<dbl>
1	39001	Adams: 3	Adams		OH	-83.46359	38.85662	ohio	adams	2020-04-17	Ohio	39001	3	0
2	39003	Allen: 65	Allen		OH	-84.10825	40.77675	ohio	allen	2020-04-17	Ohio	39003	65	9
3	39005	Ashland: 5	Ashland		OH	-82.26922	40.86122	ohio	ashland	2020-04-17	Ohio	39005	5	0
4	39007	Ashtabula: 54	Ashtabula		OH	-80.75647	41.71017	ohio	ashtabula	2020-04-17	Ohio	39007	54	4
5	39009	Athens: 3	Athens		OH	-82.04053	39.34576	ohio	athens	2020-04-17	Ohio	39009	3	1
6	39011	Auglaize: 21	Auglaize		OH	-84.22192	40.56421	ohio	auglaize	2020-04-17	Ohio	39011	21	1

lst <- list()

leaflet(ohcov19) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~ lon, 
    lat = ~ lat, 
    popup = ~htmlEscape(display),
    color = "salmon", 
    opacity = 0.10, 
    radius = ~sqrt(cases)
    ) -> leaf02

leaf02 -> lst

htmltools::tagList(lst)

lst <- list()

leaflet(ohcov19) %>%
  addTiles() %>%
  addCircleMarkers(
      lng = ~ lon, 
      lat = ~ lat, 
      popup = ~htmlEscape(display),
      color = "salmon", 
      opacity = 0.10, 
      radius = ~cases
    ) -> leaf02bad

leaf02bad -> lst

htmltools::tagList(lst)

library(plotly)

lst <- list()

ggplot() +
  geom_point(
    data = mpg,
    mapping = aes(
        x = cty, 
        y = hwy, 
        color = trans)
    ) +
  labs(
      x = "City Mileage",
      y = "Highway Mileage",
      color = "Transmission"
  ) -> pl01

ggplotly(pl01) -> lst

htmltools::tagList(lst)

Attaching package: ‘plotly’

The following objects are masked from ‘package:tidylog’:

    distinct, filter, group_by, mutate, rename, select, slice,
    summarise, transmute, ungroup

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

library(highcharter)

covid %>%
  filter(
      date == "2020-04-17"
  ) %>%
  rename(
      State = state, 
      `Total Cases` = cases
  ) -> tab1

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 

lst <- list()

hchart(
    tab1, 
    "bar", 
    hcaes(
        x = State, 
        y = `Total Cases`
        )
    ) -> hc01

hc01 -> lst
htmltools::tagList(lst)

covid %>%
  filter(
      state %in% c("Ohio", "Florida", "California", "New Jersey", "Ohio", "New York"),
      date >= "2020-03-01"
  ) %>%
  group_by(state, date) %>%
  mutate(
      log_cases = log(sum(cases))
  ) %>%
    ungroup() -> tab2

head(tab2)

A tibble: 6 × 7

date	county	state	fips	cases	deaths	log_cases
<date>	<chr>	<chr>	<chr>	<dbl>	<dbl>	<dbl>
2020-03-01	Alameda	California	06001	1	0	3.496508
2020-03-01	Humboldt	California	06023	1	0	3.496508
2020-03-01	Los Angeles	California	06037	1	0	3.496508
2020-03-01	Marin	California	06041	1	0	3.496508
2020-03-01	Napa	California	06055	1	0	3.496508
2020-03-01	Orange	California	06059	1	0	3.496508

tab2 %>%
    select(state, date, log_cases) %>%
    distinct() -> tab2_nodups

head(tab2_nodups)

A tibble: 6 × 3

state	date	log_cases
<chr>	<date>	<dbl>
California	2020-03-01	3.4965076
Florida	2020-03-01	0.6931472
New York	2020-03-01	0.0000000
California	2020-03-02	3.6375862
Florida	2020-03-02	0.6931472
New York	2020-03-02	0.0000000

lst <- list()

hchart(
    tab2_nodups, 
    "line", 
    hcaes(
        x = date, 
        y = log_cases, 
        group = state
        )
    ) -> hc02

hc02 -> lst
htmltools::tagList(lst)

covid %>%
  group_by(county, state, fips) %>%
  filter(date == "2021-11-15") %>% 
  unite(
      Location, 
      c(county, state), 
      sep = ", ", 
      remove = TRUE
  ) -> tab3

head(tab3)

A grouped_df: 6 × 5

date	Location	fips	cases	deaths
<date>	<chr>	<chr>	<dbl>	<dbl>
2021-11-15	Autauga, Alabama	01001	10407	154
2021-11-15	Baldwin, Alabama	01003	37875	581
2021-11-15	Barbour, Alabama	01005	3648	79
2021-11-15	Bibb, Alabama	01007	4317	92
2021-11-15	Blount, Alabama	01009	10536	188
2021-11-15	Bullock, Alabama	01011	1523	44

library(urbnmapr)

data(counties)

head(counties)

A tibble: 6 × 12

long	lat	order	hole	piece	group	county_fips	state_abbv	state_fips	county_name	fips_class	state_name
<dbl>	<dbl>	<int>	<lgl>	<fct>	<fct>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>
-86.91760	32.66417	1	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.81657	32.66012	2	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.71339	32.66173	3	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.71422	32.70569	4	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.41312	32.70739	5	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama
-86.41117	32.40994	6	FALSE	1	01001.1	01001	AL	01	Autauga County	H1	Alabama

counties %>%
  separate(
      county_fips, 
      into = c("stfips", "fips"), 
      sep = 2, 
      remove = FALSE
      ) %>%
  mutate(
      leader = "us", 
      stlower = stringr::str_to_lower(state_abbv)
      ) %>%
  unite(
      code, 
      c(leader, stlower, fips), 
      sep = "-"
      ) -> cdf

head(cdf)

A tibble: 6 × 14

long	lat	order	hole	piece	group	county_fips	stfips	code	state_abbv	state_fips	county_name	fips_class	state_name
<dbl>	<dbl>	<int>	<lgl>	<fct>	<fct>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>	<chr>
-86.91760	32.66417	1	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama
-86.81657	32.66012	2	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama
-86.71339	32.66173	3	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama
-86.71422	32.70569	4	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama
-86.41312	32.70739	5	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama
-86.41117	32.40994	6	FALSE	1	01001.1	01001	01	us-al-001	AL	01	Autauga County	H1	Alabama

cdf %>%
  select(code, county_fips) %>%
  distinct() -> cdf2

head(cdf2)

A tibble: 6 × 2

code	county_fips
<chr>	<chr>
us-al-001	01001
us-al-003	01003
us-al-005	01005
us-al-007	01007
us-al-009	01009
us-al-011	01011

tab3 %>%
  left_join(
      cdf2, 
      by = c("fips" = "county_fips")
  ) -> tab4

left_join: added one column (code)

           > rows only in x     117

           > rows only in y  (    9)

           > matched rows     3,133

           >                 =======

           > rows total       3,250

head(tab4)

A grouped_df: 6 × 6

date	Location	fips	cases	deaths	code
<date>	<chr>	<chr>	<dbl>	<dbl>	<chr>
2021-11-15	Autauga, Alabama	01001	10407	154	us-al-001
2021-11-15	Baldwin, Alabama	01003	37875	581	us-al-003
2021-11-15	Barbour, Alabama	01005	3648	79	us-al-005
2021-11-15	Bibb, Alabama	01007	4317	92	us-al-007
2021-11-15	Blount, Alabama	01009	10536	188	us-al-009
2021-11-15	Bullock, Alabama	01011	1523	44	us-al-011

library(viridis)

lst <- list()

hcmap("countries/us/us-all-all", 
      data = tab4,
      name = "COVID-19 Cases", value = "cases",
      joinBy = c("hc-key", "code"),
      borderColor = "steelblue") %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10)))) %>% 
  hc_legend(layout = "horizontal", align = "right",
            floating = TRUE, valueDecimals = 0, valueSuffix = ""
           ) -> hc03

hc03 -> lst

htmltools::tagList(lst)

Loading required package: viridisLite

tab4 %>%
  filter(
      grepl("-oh-", code)
  ) -> tab5

head(tab5)

A grouped_df: 6 × 6

date	Location	fips	cases	deaths	code
<date>	<chr>	<chr>	<dbl>	<dbl>	<chr>
2021-11-15	Adams, Ohio	39001	4360	105	us-oh-001
2021-11-15	Allen, Ohio	39003	17443	312	us-oh-003
2021-11-15	Ashland, Ohio	39005	7413	146	us-oh-005
2021-11-15	Ashtabula, Ohio	39007	11166	217	us-oh-007
2021-11-15	Athens, Ohio	39009	8083	93	us-oh-009
2021-11-15	Auglaize, Ohio	39011	7334	110	us-oh-011

lst <- list()

hcmap("countries/us/us-oh-all", 
      data = tab5,
      name = "COVID-19 Cases", value = "cases",
      joinBy = c("hc-key", "code"),
      borderColor = "steelblue") %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10)))) %>% 
  hc_legend(layout = "horizontal", align = "right",
            floating = TRUE, valueDecimals = 0, valueSuffix = ""
           ) -> hc04

hc04 -> lst

htmltools::tagList(lst)

library(tidyverse)

data(USArrests)
names(USArrests)
USArrests$statename <- rownames(USArrests)

head(USArrests)

1. 'Murder'
2. 'Assault'
3. 'UrbanPop'
4. 'Rape'

A data.frame: 6 × 5

	Murder	Assault	UrbanPop	Rape	statename
	<dbl>	<int>	<int>	<dbl>	<chr>
Alabama	13.2	236	58	21.2	Alabama
Alaska	10.0	263	48	44.5	Alaska
Arizona	8.1	294	80	31.0	Arizona
Arkansas	8.8	190	50	19.5	Arkansas
California	9.0	276	91	40.6	California
Colorado	7.9	204	78	38.7	Colorado